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-- file DIActionsCold.Mesa 
-- Edited by: 

Johnsson, August 29, 1978 10:02 AM 

Barbara, July 31, 1978 4:36 PM 

DIRECTORY 

DebuggerDefs: FROM "debuggerdef s" USING [ 

GetValue, InitSOP, LA, Lookup, SearchForModuleSym, SOPointer, 

SymbolObject, VariantRecord , WriteSubString] , 
DebuglnterpretDefs: FROM "debuginterpretdefs"' USING [larrayPtr], 
DebugMiscDefs: FROM "debugmiscdef s" USING [ 

DFreeString, DGetString, DWriteLongPointer , LookupFail, WriteEOL], 
DebugUtilityDefs: FROM "debugutil itydef s" USING [ 

LongREAD, MREAD, UserWriteSubString] , 
DIActionDefs: FROM "diactiondef s" USING [ 

ActualValue, AnocateHereStackltem, espTosop, 

FreeStackltem, GetCurrentST, LongValue, Notlmplemented , pushevalstack, 

Tpono'fQp'l 

DIDefs: FROM "didefs" USING [ 

ESPointer, hereESPointer , Maxindirections, Operator, predef inedType, 

thereESPointer , TIPointer, Typeltem], 
DILitDefs: FROM "dilitdefs" USING [STIndex, StringLiteralValue] . 
DITypeDefs: FROM "ditypedefs" USING [ 

SeiLonglnteger, SeiPType, TypeArray, TypeArrayDesc, TypelU, TypelUP, 

TypeLong, TypePointer, TypeString, TypeUnspec], 
lODefs: FROM "iodefs" USING [NumberFormat , WriteChar, WriteNumber] , 
StringDefs: FROM "stringdefs" USING [ 

AppendSubString, Substring, SubStringDescriptor] , 
SymDefs: FROM "symdefs" USING [SENuH], 
SystemDefs: FROM "systemdefs" USING [AllocateHeapNode, FreeHeapNode] ; 

DIActionsCold: PROGRAM 

IMPORTS DebuggerDefs, DebuglnterpretDefs, DebugMiscDefs, DebugUtilityDefs, 

DIActionDefs, DILitDefs, DITypeDefs, lODefs, StringDefs, SystemDefs 
EXPORTS DIActionDefs ■ 
BEGIN 

--using grammar version 7 

--stack items 

ESPointer: TYPE « DIDefs . ESPointer ; 
hereESPointer: TYPE » DIDefs. hereESPointer ; 
thereESPointer: TYPE = DIDefs. thereESPointer ; 
TIPointer: TYPE « DIDefs. TIPointer ; 
SOPointer: TYPE » DebuggerDefs .SOPointer ; 

--stack and index for stack 

MaxStackSize: CARDINAL - 5; 

typestack: ARRAY [1 . .MaxStackSize] OF TIPointer; 

ttop: CARDINAL ♦- 0; 

--type stack manipulation 
TypeStackOverflow: PUBLIC SIGNAL « CODE; 
TypeStackEmpty: PUBLIC SIGNAL « CODE; 

pushtypestack: PUBLIC PROCEDURE [tip: TIPointer] « 
BEGIN 

IF ttop « MaxStackSize THEN SIGNAL TypeStackOverflow; 
ttop «- ttop + 1; 
typestack[ttop] ♦- tip; 
RETURN 
END; 

poptypestack: PUBLIC PROCEDURE RETURNS [tip: TIPointer] « 
BEGIN 

IF ttop « THEN SIGNAL TypeStackEmpty; 
tip <- typestack[ttop]; 
ttop ♦- ttop - 1; 
RETURN 
END; 

loopholeltem: PUBLIC PROCEDURE [esp : ESPointer, tip: TIPointer] 
RETURNS [ESPointer] - 

BEGIN OPEN si: esp.stbase, s2: tip.stbase; 
esp.stbase ^ tip.stbase; 
esp. tsei <~ tip. tsei ; 
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esp. indirection ♦- tip. indirection; 

FreeTypeItem[tip]; 

RETURN[esp] 

END; 

loopholeUnspecItem: PUBLIC PROCEDURE [esp: ESPointer] RETURNS [ESPointer] - 
BEGIN 

esp.tsei ^ DITypeDefs .SeiPType[unspecif ied, esp.stbase]; 
esp. indirection <- 0; esp.intN ^ esp.desc <- FALSE; 
RETURN[esp] 
END; 

minusltem: PUBLIC PROCEDURE [esp: ESPointer] RETURNS [new: hereESPointer] ■ 
BEGIN OPEN DIActionDefs; 

IF -DITypeDefs. TypeIU[esp] THEN SIGNAL IncorrectType[esp] ; 
new ^ TransFer[esp]; 
IF new.wordlength ■ 1 THEN 
BEGIN 

new. value ^ -Actua1Value[new]; 

WITH new.stbase.seb+new.stbase.UnderType[new. tsei] SELECT FROM 
subrange "> 

IF origin # THEN new. value <- new. value-origin; 
ENDCASE; 
END 
ELSE LOOPHOLE[new.ptr, POINTER TO LONG INTEGER]t ♦- - LongValue[new] ; 
RETURN 
END; 

TooManylndirections: PUBLIC SIGNAL » CODE; 

addressof Item: PUBLIC PROCEDURE [tesp: thereESPointer] 
RETURNS [new: hereESPointer] » 
BEGIN 
IF tesp. indirection = DIDef s.MaxIndirections THEN 

BEGIN DIActionDefs. FreeStackItem[tesp]; SIGNAL TooManylndirections; END; 
new ♦- DIActionDefs .AllocateHereStackItem[]; 
WITH tesp SELECT FROM 

short => new. value ^ shortAddr; 
long »> 
BEGIN 

new.ptr ♦- SystemDef s.Al locateHeapNode[new.wordlength ♦- 2]; 
LOOPHOLE[new.ptr, POINTER TO DebuggerDef s . LA]t 4- longAddr; 
END; 
ENDCASE; 
new.stbase <- tesp.stbase; 
new. tsei ^ tesp. tsei; 
new. indirection «- tesp . indirection + 1; 
DIActionDefs .FreeStackItem[tesp] ; 
RETURN 
END; 

IncorrectType: PUBLIC SIGNAL [esp: ESPointer] « CODE; 

--built in calls 

lengthltem: PUBLIC PROCEDURE [esp: ESPointer] RETURNS [new: hereESPointer] - 
BEGIN OPEN s: esp.stbase, DITypeDefs. DIActionDefs, DebugUtil ityDef s ; 
IF '-(TypeArray[esp] OR TypeArrayDesc[esp]) THEN SIGNAL IncorrectType[esp]; 
new <- AnocateHereStackIteni[] ; 
IF TypeArrayDesc[esp] THEN 
WITH e:esp SELECT FROM 

here «> new. value ^ (e.ptr+l)t; 

there «> WITH esp. stbase. seb+esp. stbase.UnderType[esp. tsei] SELECT FROM 
long »> WITH e SELECT FROM 

short => new. value ♦- MREAD[shortAddr+2] ; 
long => new, value <- LongREAD[longAddr . lp+2]; 
ENDCASE; 
arraydesc -> WITH e SELECT FROM 

short «> new. value <- MREAD[shortAddr + l] ; 
long =•> new. value <^- LongREAD[longAddr. lp+1]; 
ENDCASE; 
ENDCASE «> ERROR; 
ENDCASE «> ERROR 
ELSE 

WITH esp SELECT FROM 

there «> WITH a: s , seb + s.UnderType[esp . tsei] SELECT FROM 
array «> new. value <- s .Cardinal ity[a. indextype]; 
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ENDCASE ■> ERROR; 
ENDCASE -> ERROR; 
new.tsei <- SeiPTypeCinteger . DIActionDefs.GetCurr0ntST[]]; 
FreeStackItem[esp]; 
RETURN 
END; 

baseltem: PUBLIC PROCEDURE [esp: ESPointer] RETURNS [new: hereESPointer] ■ 
BEGIN OPEN DITypeDefs, DIActionDef s , DebugUtil ityDef s; 

IF '-(TypeArray[0sp] OR TypeArrayD8Sc[esp]) THEN SIGNAL IncorrectType[esp]; 
new <- AnocateHereStackItem[]; 
IF TypeArrayDesc[esp] THEN 
WITH e:esp SELECT FROM 

here «> new. value <- (e.ptr)t; 
there -> WITH e SELECT FROM 

short ■> new. value ♦- MREAD[shortAddr]; 
long °> new. value ♦■ LongREAD[longAddr. Ip]; 
ENDCASE; 
ENDCASE -> ERROR 
ELSE 

WITH e:esp SELECT FROM 

there -> WITH e SELECT FROM 

short «> new. value *- shortAddr; 
long ■> 
BEGIN 

new.ptr ^ SystemDef s.Al locateHeapNode[new.wordlength ♦- 2]; 
LOOPHOLE[new.ptr, POINTER TO DebuggerDef s . LA]t 4- longAddr; 
END; 
ENDCASE; 
ENDCASE -> ERROR; 
new.tsei ♦- SeiPType[unspecified, DIActionDef s .GetCurrentST[]]; 
new. indirection ^ 1; 
FreeStackItem[esp] ; 
RETURN 
END; 

desclltem: PUBLIC PROCEDURE [name: thereESPointer] 
RETURNS [new: hereESPointer] - 
BEGIN OPEN n: name.stbase, DIActionDef s; 
csize: CARDINAL; 

IF ~DITypeDef s .TypeArray[name] THEN SIGNAL IncorrectType[name] ; 
new <- AnocateHereStackItem[3; 
new.desc <- TRUE; 

new.ptr *• SystemDef s.AnocateHeapNode[new.wordlength ^ 2]; 
WITH name SELECT FROM 

short =*> new.ptrt *- DebugUtil ityDef s .MREAD[shortAddr]; 

long => new.ptrt <- DebugUtil ityDef s . LongREAD[longAddr. Ip]; 

ENDCASE; 
WITH {n.seb+n.UnderType[name.tsei3) SELECT FROM 

array => csize ♦- n .WordsForType[componenttype]; 

ENDCASE «> ERROR; 
(new.ptr+l)t <- (n . seb+name. sei ) . idinfo / csize; 
FreeStackItem[name] ; 
RETURN 
END; 

desc2Item: PUBLIC PROCEDURE [length, base: ESPointer] 
RETURNS [new: hereESPointer] - 
BEGIN OPEN DITypeDefs. DIActionDef s ; 
hi: hereESPointer; 
h2: hereESPointer; 

IF ~TypeIU[length] THEN SIGNAL IncorrectType[length] ; 

IF ~(TypePointer[base] OR TypeUnspec[base]) THEN SIGNAL IncorrectType[base] ; 
IF TypeLong[base] THEN SIGNAL DIAct ionDef s . Notlmplemented ; 
hi ♦- Transfer[base] ; h2 *- Transfer[l ength]; 
new *- AnocateHereStackItem[] ; 
new.desc <- TRUE; 

new.ptr ♦- SystemDef s .Al locateHeapNode[new.wordlength <- 2]; 
new.ptrt f- DIActionDefs .ActualValue[hl]; 
(new.ptr + l)t <r DIActionDefs .ActualValue[h2]; 
FreeStackItem[hl]; FreeStackItem[h2] ; 
RETURN 
END; 

memltem: PUBLIC PROCEDURE [esp: ESPointer] RETURNS [new: hereESPointer] « 
BEGIN OPEN DIActionDefs; 
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IF ~DITypeDefs.TypeIUP[esp] THEN SIGNAL IncorrectType[esp]; 

new <- AnocatellereStackIt0m[]; 

new <- Transfer[esp]; 

new.tsei ^ DITypeDefs.SeiPTypeCunspecif ied, DIActionDef s .GetCurrentST[]] ; 

new. value *• DebugUtil ityDef s.LongREAD[L00PH0LE[LongVa1ue[new]]]; 

RETURN 

END; 

--type operations 

typeOp: PUBLIC PROCEDURE [typeop: DIDefs. Operator, tip: TIPointer] 
RETURNS [new: hereESPointer] ■ 
BEGIN OPEN t:tip.stbase; 

new <- DIActionD0fs.AnocateHereStackItem[]; 
SELECT typeop FROM 
size ■> 
BEGIN 

new.tsei <- DITypeDefs.SeiPType[integer,DIActionDefs.GetCurrentST[]]; 
new. value <- IF tip.stbase // NIL THEN t.WordsForType[tip. tsei] 
ELSE IF tip. tsei ■ DITypeDef s .SeiLonglnteger THEN 2 ELSE 1; 
END; 
ENDCASE -> ERROR; 
FreeTypeItem[tip]; 
RETURN 
END; 

setPredef ined: PUBLIC PROCEDURE [type: DIDefs .predefinedType] 
RETURNS [tip: TIPointer] - 
BEGIN 

tip ♦- AnocateTypeItein[]; 

tip. tsei ♦- DITypeDefs.SeiPType[type, DIActionDefs.GetCurrentST[]]; 
RETURN 
END; 

SearchFileForType: PUBLIC PROCEDURE [file, id: DILitDef s.STIndex] 
RETURNS [tip: TIPointer] « 
BEGIN OPEN DebugMiscDefs, DebuggerDef s; 
mod: STRING ^ DGetString[30] ; 
type: STRING <- DGetString[30] ; 
so: SymbolObject; 
sop: SOPointer <- 0so; 
InitSOP[sop]; 

StringDefs.AppendSubString[mod, DILitDef s .StringLitera1Va1ue[f ile]]; 
StringDefs.AppendSubSt ring [type, DILitDef s .StringLiteralVa1ue[id]]; 
IF '-SearchForModu1eSym[mod, type, FALSE, sop, TRUE] THEN 

BEGIN 

DFreeString[mod] ; 

SIGNAL DebugMiscDefs. Lookup Fail [type]; 

END; 
tip ♦- AnocateTyp0ltem[]; 
tip.stbase ♦- sop.stbase; 
tip. tsei <- sop.sei ; 
DFreeString[mod]; 
DFreeString[typ0]; 
RETURN 
END; 

SearchForType: PUBLIC PROCEDURE [id: DILitDef s.STIndex] 
RETURNS [tip: TIPointer] « 
BEGIN OPEN DebuggerDefs; 
s: STRING <- DebugMiscDefs . DGetString[30] ; 
so: SymbolObject; 
sop: SOPointer <- 0so; 
InitSOP[sop]; 

StringDefs.AppendSubString[s. DILi tDef s .StringLitera1Va1ue[id]] ; 
IF ~Lookup[s, FALSE, sop. TRUE, mod] 

THEN SIGNAL DebugMiscDefs . LookupFail [s] ; 
tip <- AllocateTyp0ltem[]; 
tip.stbase ^ sop.stbase; 
tip. tsei *■ sop. sei ; 
DebugMiscDef s.DFreeString[s]; 
RETURN 
END; 

InvalidType: PUBLIC SIGNAL [tip: TIPointer] « CODE; 

SearchForVariantType: PUBLIC PROCEDURE [var: DILitDef s .STIndex, tip: TIPointer] 
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RETURNS [TIPointer] ■ 

BEGIN OPEN DebuggerDefsj 

so: SymbolObject; 

sop: SOPointer ^ 0so; 

InitSOP[sop]; 

sop.stbase ♦- tip.stbase; sop.tsei ^ tip.tsei; 

IF sop.stbase " NIL OR ~VariantRecord[sop .DILitDef s .StringLitera1Va1ue[var]] 

THEN SIGNAL Inval iclTyp0[tip] 
ELSE BEGIN tip.stbase ^ sop.stbase; tip.tsei <r sop.sei; END; 
RETURN[tip] 
END; 

pointertoType: PUBLIC PROCEDURE [tip: TIPointer] RETURNS [TIPointer] ■ 
BEGIN 
IF tip. indirection < DIDef s .Maxindirections 

THEN tip. indirection ♦- tip. indirection + 1 
ELSE BEGIN 

FreeTyp0ltem[tip]; 

SIGNAL TooManylndirections; 

END; 
RETURN[tip] 
END; 

--new interval notation 

setlntervalBit: PUBLIC PROCEDURE [esp: ESPointer] RETURNS [ESPointer] « 

BEGIN 

esp.intN ^ TRUE; 

RETURN[esp] 

END; 

Inval idLonglnterval: PUBLIC SIGNAL [left, right: LONG INTEGER] - CODE; 

printOctal: PUBLIC PROCEDURE [n, start: ESPointer] ■ 
BEGIN OPEN lODefs, DITypeDefs, DIActionDefs; 
i: INTEGER ^ -1; 
count: INTEGER; 
j, end: LONG INTEGER; 
leftside: LONG POINTER; 
side2: hereESPointer; 

IF '-TypeIU[n] THEN SIGNAL IncorrectType[n]; 
IF ~TypeIUP[start] THEN SIGNAL IncorrectType[start]; 
leftside <- LOOPHOLE[LongValue[Transf er[start]]]; 
side2 <- Transfer[n]; 

IF sideZ.intN THEN end <- LongValue[side2] 

ELSE end <- LongValue[side2] - LOOPHOLE[lef tSide, LONG INTEGER] +1; 
--IF leftside > rightSide 

--THEN SIGNAL Inval idLonglnterval [1 eftSide . rightSide]; 
FOR j ♦- 0. j + 1 UNTIL j « end DO 
IF (i <- i+ 1) MOD 8 « THEN 

BEGIN 

DebugMiscDefs.WriteEOL[]; 

DebugMiscDefs.DWriteLongPointer[leftSide + j. 8]; 

WriteChar['/] 

END; 

WriteChar[' ]; 

WriteNumber[count <- DebugUtil ityDef s .LongREAD[LOOPHOLE[lef tSide + j]]. Numb0rForniat[8. FALSE, TRUE. 6] 
♦ ♦"j . 

*WriteChar[IF count '-IN[0..7] THEN 'B ELSE ' ]; 
ENDLOOP; 
--note to stop after interval 
pushevalstack[setIntervalBit[side2]]; 
RETURN 
END; 

Invalidlnterval : PUBLIC SIGNAL [bl. b2: UNSPECIFIED] « CODE; 

printlnterval : PUBLIC PROCEDURE [n, start, exp: ESPointer] - 
BEGIN OPEN DITypeDefs, DIActionDefs; 
so: Deb uggerDefs. Symbol Object; 
sop: SOPointer ^ 0so; 
ss: StringDef s .SubStringDescriptor ; 
hi: hereESPointer; 
h2: hereESPointer; 

IF ~TypeIU[n] THEN SIGNAL IncorrectTyp0[n] ; 
IF ~Typ0lU[start] THEN SIGNAL Incorrec tType[s tart] ; 
IF ~{TypeArray[exp] OR TypeArrayDescCexp] OR TypeString[exp]) 
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THEN SIGNAL IncorrectTyp8[8xp] ; 
hi ♦- Transfer[start]; h2 ^ Transfer[n]; 
hi. value ♦- ActualVa1ue[hl]; h2. value ♦- Actua1Valu8[h2] ; 
IF '-h2.intN THEN h2. value ^ h2. value - hi. value + 1; 
IF h2. value < 1 

THEN SIGNAL Inval idlnterval [hi . value , h2, value]; 
espTosop[exp,sop]; 
IF TypeString[exp] THEN 
WITH exp SELECT FROM 
there ■> 
BEGIN 

ss ^[LOOPHOLE[DebuggerDefs.GetValue[sop]. STRING], hi. value, h2. value]; 
DebugUtil ityDef s .UserWriteSubString[0ss]; 
END; 
here ■> 
BEGIN 

ss ^ [LOOPHOLE[value,StringDefs. Substring]. base, hi. value, h2. value]; 
DebuggerDefs.WriteSubString[0ss]; 
END; 
ENDCASE -> ERROR 
ELSE DebugInterpretDefs.IarrayPtr[sop, hi. value, h2. value]; 
--note to stop after interval 
pushevalstack[setIntervalBit[h2]]; 
FreeStackItem[hl]; FreeStackItem[exp] ; 
RETURN 
END; 

TypeStackList: TIPointer *- NIL; 

AllocateTypeltem: PROCEDURE RETURNS [tip: TIPointer] - 
BEGIN OPEN DIDefs; 

tip <- SysteniDefs.AnocateHeapNode[SIZE[TypeIt8m]]; 
tipt 4- Typeltem[next: TypeStackList, stbase: DIActionDefs.G8tCurrentST[], 

tsei: SymDefs.SENull , indirection: 0]; 
TypeStackList ♦- tip; 
RETURN 
END; 

FreeTypeltem: PROCEDURE [tip: TIPointer] - 
BEGIN 

dl: TIPointer <- TypeStackList; 
pdl : TIPointer <- NIL; 
UNTIL dl « NIL DO 
IF dl « tip THEN 
BEGIN 

IF pdl « NIL THEN TypeStackList <- dl.next ELSE pdl. next <- dl.next; 
SystemDef s. FreeHeapNode[tip]; 
RETURN 
END; 
pdl ♦- dl ; dl ^ dl . next; 
ENDLOOP; 
RETURN 
END; 

ResetTypeStack: PUBLIC PROCEDURE - 
BEGIN 

tip: TIPointer ^ TypeStackList; 
ntip: TIPointer; 
UNTIL tip « NIL DO 

ntip ^ tip. next; 

SystemDef s . FreeHeapNode[tip]; 

tip ^ ntip; 

ENDLOOP; 
TypeStackList ^ NIL; ttop ♦- 0; 
RETURN 
END; 

END.. 



